home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / LIB211.ZIP;1 / CONVERT.PRG < prev    next >
Encoding:
Text File  |  1993-11-22  |  55.0 KB  |  1,434 lines
  1. *-----------------------------------------------------------------------
  2. *-- Program...: CONVERT.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 08/27/1993
  5. *-- Notes.....: This is a complete overhaul of the CONVERT program in 
  6. *--             LIBxxx.ZIP - Jay went through it and did massive work.
  7. *--             For details on this file (and others in the library) see
  8. *--             README.TXT.
  9. *-----------------------------------------------------------------------
  10.  
  11. FUNCTION Roman
  12. *-----------------------------------------------------------------------
  13. *-- Programmer..: Nick Carlin
  14. *-- Date........: 08/27/1993
  15. *-- Notes.......: A function designed to return a Roman Numeral based on
  16. *--               an Arabic Numeral input ...
  17. *-- Written for.: dBASE III+
  18. *-- Rev. History: 04/13/1988 - original function.
  19. *--               07/25/1991 - Ken Mayer - 1) modified for dBASE IV, 
  20. *--                             1.1, 2) updated to a function, and 
  21. *--                             3) the procedure GetRoman was done away
  22. *--                             with (combined into the function).
  23. *--               04/26/1992 - Jay Parsons - shortened (seriously ...)
  24. *--               08/27/1993 - Jay Parsons - dBASE IV 2.0 bug worked 
  25. *--                            around
  26. *-- Calls.......: None
  27. *-- Called by...: Any
  28. *-- Usage.......: Roman(<nArabic>)
  29. *-- Example.....: ? Roman(32)
  30. *-- Returns.....: Roman Numeral (character string) equivalent of Arabic 
  31. *--               numeral passed to it. In example:  XXXII
  32. *-- Parameters..: nArabic = Arabic number to be converted to Roman
  33. *-----------------------------------------------------------------------
  34.  
  35.    parameters nArabic
  36.    private cLetrs,cRoman,nCount,nLeft,nMod,nNines,cAdd
  37.    
  38.    m->cLetrs ="IVXLCDMWY"         && Roman digits
  39.    m->cRoman = ""                 && this will be the returned value
  40.    m->nCount = 0                  && init counter
  41.    m->nLeft = fixed( m->nArabic )
  42.    if m->nLeft < 0 .or. m->nLeft # int( m->nLeft )
  43.      RETURN m->cRoman
  44.    endif
  45.    do while m->nCount < 4 .and. m->nLeft > 0  && loop four times, once 
  46.                                               && each for 1s, 10s, 
  47.                                               && 100s, 1000s
  48.      m->nMod = mod( m->nLeft, 10 )
  49.      m->nLeft = int( m->nLeft / 10 )
  50.      m->cGroup = substr( m->cLetrs, 2 * m->nCount + 1, 3 )
  51.      m->cAdd = ""
  52.      do case
  53.        case m->nMod = 9
  54.          m->cAdd = left( m->cGroup, 1 ) + right( m->cGroup, 1 )
  55.        case m->nMod = 4
  56.          m->cAdd = left( m->cGroup, 2 )
  57.        otherwise
  58.          if m->nMod > 4                    && 5 - 8
  59.            m->cAdd = substr( m->cGroup, 2, 1 )
  60.            m->nMod = m->nMod - 5
  61.          endif
  62.          if m->nMod > 0                    && 1 - 3 and 6 - 8
  63.             m->cAdd = m->cAdd + replicate(left( m->cGroup, 1 ), m->nMod)
  64.          endif
  65.      endcase
  66.      m->cRoman = m->cAdd + m->cRoman
  67.      m->nCount = m->nCount + 1
  68.    enddo  && while nCounter < 4
  69.         
  70. RETURN m->cRoman
  71. *-- EoF: Roman()
  72.  
  73. FUNCTION Arabic
  74. *-----------------------------------------------------------------------
  75. *-- Programmer..: Ken Mayer (CIS: 71333,1030)
  76. *-- Date........: 04/26/1992
  77. *-- Notes.......: This function converts a Roman Numeral to an arabic 
  78. *--               one. It parses the roman numeral into an array, and 
  79. *--               checks each character ... if the previous character 
  80. *--               causes the value to subtract (for example, IX = 9, 
  81. *--               not 10) we subtract that value, and then set the 
  82. *--               previous value to 0, otherwise we would get
  83. *--               some odd values in return. So far, it works fine.
  84. *-- Written for.: dBASE IV, 1.1
  85. *-- Rev. History: 07/15/1991 - original function.
  86. *--               04/26/1992 - Jay Parsons - shortened.
  87. *-- Calls.......: None
  88. *-- Called by...: Any
  89. *-- Usage.......: Arabic(<cRoman>)
  90. *-- Example.....: ?Arabic("XXIV")
  91. *-- Returns.....: Arabic number (from example, 24)
  92. *-- Parameters..: cRoman = character string containing roman numeral to 
  93. *--                        be converted.
  94. *-----------------------------------------------------------------------
  95.  
  96.   parameters cRoman
  97.   private cRom,cLetrs,nLast,nAt,nVal,cChar,nArabic
  98.    
  99.    m->cRom = ltrim(trim(upper(m->cRoman))) &&convert to all caps in case
  100.    m->cLetrs = "IVXLCDMWY"
  101.    m->nArabic = 0
  102.    m->nLast = 0
  103.    do while len( m->cRom ) > 0
  104.       m->cChar = right( m->cRom, 1 )
  105.       m->nAt = at( m->cChar, m->cLetrs )
  106.       m->nVal= 10 ^ int( m->nAt/2 ) / iif(m->nAt/2 = int(m->nAt/2),2,1)
  107.       do case
  108.          case m->nAt = 0
  109.             m->nArabic = 0
  110.             exit
  111.          case m->nAt >= m->nLast
  112.             m->nArabic = m->nArabic + m->nVal
  113.             m->nLast = m->nAt
  114.          otherwise
  115.             if m->nAt/2 = int( m->nAt / 2 )
  116.                m->nArabic = 0
  117.                exit
  118.             else
  119.                m->nArabic = m->nArabic - m->nVal
  120.             endif
  121.       endcase
  122.       m->cRom = left( m->cRom, len( m->cRom ) - 1 )
  123.    enddo
  124.    
  125. RETURN m->nArabic
  126. *-- EoF: Arabic()
  127.  
  128. FUNCTION Factorial
  129. *-----------------------------------------------------------------------
  130. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  131. *-- Date........: 03/01/1992
  132. *-- Notes.......: Factorial of a number; returns -1 if number is not a
  133. *--               positive integer.
  134. *-- Written for.: dBASE IV, 1.1
  135. *-- Rev. History: 03/01/1992
  136. *-- Calls.......: None
  137. *-- Called by...: Any
  138. *-- Usage.......: Factorial(<nNumber>)
  139. *-- Example.....: ? Factorial( 6 )
  140. *-- Returns.....: Numeric = number factorial <in example, 6! or 720>
  141. *-- Parameters..: nNumber = number for which factorial is to be 
  142. *--                         determined
  143. *-----------------------------------------------------------------------
  144.  
  145.    parameters nNumber
  146.    private nNext, nProduct
  147.  
  148.    if m->nNumber # int( m->nNumber ) .or. m->nNumber < 1
  149.      RETURN -1
  150.    endif
  151.    m->nProduct = 1
  152.    m->nNext = m->nNumber
  153.    do while m->nNext > 1
  154.       m->nProduct = m->nProduct * m->nNext
  155.       m->nNext = m->nNext - 1
  156.    enddo
  157.    
  158. RETURN m->nProduct
  159. *-- Eof: Factorial()
  160.                                  
  161. FUNCTION IsPrime
  162. *-----------------------------------------------------------------------
  163. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  164. *-- Date........: 08/11/1992
  165. *-- Notes.......: Returns .t. if argument is prime positive integer, or 
  166. *--               .f.
  167. *-- Written for.: dBASE IV, 1.1
  168. *-- Rev. History: 03/11/92 - original function.
  169. *--             : 08/11/92 - revised to return .T. for 2. (Tea for two?)
  170. *-- Calls.......: None
  171. *-- Called by...: Any
  172. *-- Usage.......: IsPrime(<nNumber>)
  173. *-- Example.....: ? IsPrime( 628321 )
  174. *-- Returns.....: Logical = .t. if prime
  175. *-- Parameters..: nNumber = positive integer to test for being prime
  176. *-----------------------------------------------------------------------
  177.  
  178.    parameters nNumber
  179.    private nFactor, nLimit, lResult
  180.  
  181.    if m->nNumber < 1 .or. m->nNumber # int( m->nNumber ) ;
  182.       .or. ( m->nNumber > 2 .AND. mod( m->nNumber, 2 ) = 0 )
  183.       RETURN .f.
  184.    endif
  185.    m->nFactor = 3
  186.    m->nLimit = sqrt( m->nNumber )
  187.    m->lResult = .t.
  188.    do while m->nFactor <= m->nLimit
  189.       if mod( m->nNumber, m->nFactor ) = 0
  190.          m->lResult = .f.
  191.          exit
  192.       endif
  193.       m->nFactor = m->nFactor + 2
  194.    enddo
  195.  
  196. RETURN m->lResult
  197. *-- Eof: IsPrime()
  198.  
  199. FUNCTION BankRound
  200. *-----------------------------------------------------------------------
  201. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  202. *-- Date........: 03/01/1992
  203. *-- Notes.......: Rounds numeric argument to given number of places,
  204. *--               which if positive are decimal places, otherwise
  205. *--               trailing zeroes before the decimal, in accordance
  206. *--               with the special banker's rule that if the value
  207. *--               lost by rounding is exactly halfway between two
  208. *--               possible digits, the final digit expressed will be 
  209. *--               even.
  210. *-- Written for.: dBASE IV, 1.1
  211. *-- Rev. History: 03/01/1992
  212. *-- Calls.......: None
  213. *-- Called by...: Any
  214. *-- Usage.......: BankRound(<nNumber>,<nPlaces>)
  215. *-- Example.....: ? BankRound( 357.725, 2 )
  216. *-- Returns.....: Numeric = rounded value ( 357.72 in example )
  217. *-- Parameters..: nNumber = numeric value to round
  218. *--               nPlaces = decimal places, negative being powers of 10
  219. *-----------------------------------------------------------------------
  220.  
  221.    parameters nNumber, nPlaces
  222.    private nTemp
  223.  
  224.    m->nTemp = m->nNumber * 10 ^ m->nPlaces +.5
  225.    if m->nTemp = int( m->nTemp ) .and. m->nTemp / 2 # int(m->nTemp / 2)
  226.       m->nTemp = m->nTemp - 1
  227.    endif
  228.    
  229. RETURN int( m->nTemp ) / 10 ^ m->nPlaces
  230. *-- Eof: BankRound()
  231.  
  232. FUNCTION Dec2Hex
  233. *-----------------------------------------------------------------------
  234. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  235. *-- Date........: 03/01/1992
  236. *-- Notes.......: Converts an unsigned integer ( in decimal notation)
  237. *--               to a hexadecimal string
  238. *-- Written for.: dBASE IV, 1.1
  239. *-- Rev. History: 03/01/1992
  240. *-- Calls.......: None
  241. *-- Called by...: Any
  242. *-- Usage.......: Dec2Hex(<nDecimal>)
  243. *-- Example.....: ? Dec2Hex( 118 )
  244. *-- Returns.....: Character = Hexadecimal equivalent ( "F6" in example )
  245. *-- Parameters..: nDecimal = number to convert
  246. *-----------------------------------------------------------------------
  247.    
  248.    parameters nDecimal
  249.    private nD, cH
  250.  
  251.    m->nD = int( m->nDecimal )
  252.    m->cH= ""
  253.    do while m->nD > 0
  254.      m->cH = substr( "0123456789ABCDEF", mod( m->nD, 16 ) + 1 , 1 );
  255.                           + m->cH
  256.      m->nD = int( m->nD / 16 )
  257.    enddo
  258.    
  259. RETURN iif( "" = m->cH, "0", m->cH )
  260. *-- Eof: Dec2Hex()
  261.  
  262. FUNCTION Hex2Dec
  263. *-----------------------------------------------------------------------
  264. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  265. *-- Date........: 11/26/1992
  266. *-- Notes.......: Converts a hexadecimal character string representing
  267. *--               an unsigned integer to its numeric (decimal) 
  268. *--               equivalent.
  269. *-- Written for.: dBASE IV, 1.1
  270. *-- Rev. History: 03/01/92 - original function.
  271. *--               11/26/92 - modified to eliminate usually-harmless
  272. *--               "substring out of range" error, Jay Parsons
  273. *-- Calls.......: None
  274. *-- Called by...: Any
  275. *-- Usage.......: Hex2Dec(<cHex>)
  276. *-- Example.....: ? Hex2Dec( "F6" )
  277. *-- Returns.....: Numeric = equivalent ( 118 in example )
  278. *-- Parameters..: cHex = character string to convert
  279. *-----------------------------------------------------------------------
  280.  
  281.    parameters cHex
  282.    private nD, cH
  283.  
  284.    m->cH = upper( trim( ltrim (  m->cHex ) ) ) + "!"
  285.    m->nD = 0
  286.    do while len( cH ) > 1
  287.       m->nD = m->nD * 16 + at( left( m->cH, 1 ), "123456789ABCDEF" )
  288.       m->cH = substr( m->cH, 2 )
  289.    enddo
  290.    
  291. RETURN m->nD
  292. *-- Eof: Hex2Dec()
  293.  
  294. FUNCTION Hex2Bin
  295. *-----------------------------------------------------------------------
  296. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  297. *-- Date........: 12/01/1992
  298. *-- Notes.......: Converts a hexadecimal character string representing
  299. *--               an unsigned integer to its binary string equivalent
  300. *-- Written for.: dBASE IV, 1.1
  301. *-- Rev. History: 03/01/92 - original function.
  302. *--               12/01/92 - modified to eliminate usually-harmless
  303. *--               "substring out of range" error, Jay Parsons
  304. *-- Calls.......: None
  305. *-- Called by...: Any
  306. *-- Usage.......: Hex2Bin(<cHex>)
  307. *-- Example.....: ? Hex2Bin( "F6" )
  308. *-- Returns.....: Character = binary string ( "1111 0110" in example )
  309. *-- Parameters..: cHex = character string to convert
  310. *-----------------------------------------------------------------------
  311.    
  312.    parameters cHex
  313.    private cH, cBits, cNybbles, cVal
  314.  
  315.    m->cH = upper( trim( ltrim(  m->cHex ) ) ) + "!"
  316.    m->cBits = ""
  317.    m->cNybbles = "00000001001000110100010101100111" ;
  318.                 +"10001001101010111100110111101111"
  319.    do while len( m->cH ) > 1
  320.       m->cVal = left( m->cH, 1 )
  321.       if m->cVal # " "
  322.          m->cBits =  m->cBits + " " + substr(  m->cNybbles, ;
  323.                      at ( m->cVal, "123456789ABCDEF" ) * 4 + 1, 4 )
  324.       endif
  325.       m->cH = substr( m->cH, 2 )
  326.    enddo
  327.    
  328. RETURN iif( "" =  m->cBits, "0", ltrim(  m->cBits ) )
  329. *-- Eof: Hex2Bin()
  330.  
  331. FUNCTION Bin2Hex
  332. *-----------------------------------------------------------------------
  333. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  334. *-- Date........: 03/01/1992
  335. *-- Notes.......: Converts a binary character string representing
  336. *--               an unsigned integer to its hexadecimal string 
  337. *--               equivalent.
  338. *-- Written for.: dBASE IV, 1.1
  339. *-- Rev. History: 03/01/1992
  340. *-- Calls.......: None
  341. *-- Called by...: Any
  342. *-- Usage.......: Bin2Hex(<cBin>)
  343. *-- Example.....: ? Bin2Hex( "1111 0110" )
  344. *-- Returns.....: Character = hexadecimal string ( "F6" in example )
  345. *-- Parameters..: cBin = character string to convert
  346. *-----------------------------------------------------------------------
  347.  
  348.    parameters cBin
  349.    private cH, cBits, nBits, nBval, cNext
  350.  
  351.    m->cBits = trim( ltrim( m->cBin ) )
  352.    m->nBits = len(  m->cBits ) - 1
  353.    do while m->nBits > 0
  354.       if substr(  m->cBits, m->nBits, 1 ) $ ", "
  355.          m->nBVal = mod( 4 - mod( len(  m->cBits ) - m->nBits, 4 ), 4 )
  356.          m->cBits = stuff(  m->cBits, m->nBits, 1, ;
  357.                             replicate( "0", m->nBVal ) )
  358.       endif
  359.       m->nBits = m->nBits - 1
  360.    enddo
  361.    m->cH = ""
  362.    do while "" #  m->cBits
  363.       store 0 to m->nBits, m->nBVal
  364.       do while m->nBits < 4
  365.          m->cNext = right(  m->cBits, 1 )
  366.          m->nBVal = m->nBVal + iif( m->cNext = "1", 2 ^ m->nBits, 0 )
  367.          m->cBits = left(  m->cBits, len(  m->cBits ) - 1 )
  368.          if "" =  m->cBits
  369.             exit
  370.          endif
  371.          m->nBits = m->nBits + 1
  372.       enddo
  373.       m->cH = substr( "0123456789ABCDEF", m->nBVal + 1, 1 ) + m->cH
  374.    enddo
  375.    
  376. RETURN iif( "" = m->cH, "0", m->cH )
  377. *-- Eof: Bin2Hex()
  378.  
  379. FUNCTION Dec2Oct
  380. *-----------------------------------------------------------------------
  381. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  382. *-- Date........: 03/01/1992
  383. *-- Notes.......: Converts an unsigned integer to its octal string 
  384. *--               equivalent
  385. *-- Written for.: dBASE IV, 1.1
  386. *-- Rev. History: 03/01/1992
  387. *-- Calls.......: None
  388. *-- Called by...: Any
  389. *-- Usage.......: Dec2Oct(<nDec>)
  390. *-- Example.....: ? Dec2Oct( 118 )
  391. *-- Returns.....: Character = octal string ( "166" in example )
  392. *-- Parameters..: nDec = number to convert
  393. *-----------------------------------------------------------------------
  394.    
  395.    parameters nDec
  396.    private nD, cO
  397.  
  398.    m->nD = int( m->nDec )
  399.    m->cO = ""
  400.    do while m->nD > 0
  401.      m->cO = substr( "01234567", mod( m->nD, 8 ) + 1 , 1 ) + m->cO
  402.      m->nD = int( m->nD / 8 )
  403.    enddo
  404.  
  405. RETURN iif( "" = m->cO, "0", m->cO )
  406. *-- Eof: Dec2Oct()
  407.  
  408. FUNCTION Oct2Dec
  409. *-----------------------------------------------------------------------
  410. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  411. *-- Date........: 12/01/1992
  412. *-- Notes.......: Converts an unsigned number in octal, or its string
  413. *--               representation, to a numeric (decimal) value
  414. *-- Written for.: dBASE IV, 1.1
  415. *-- Rev. History: 03/01/92 - original function.
  416. *--               12/01/92 - modified to eliminate usually-harmless
  417. *--               "substring out of range" error, Jay Parsons
  418. *-- Calls.......: None
  419. *-- Called by...: Any
  420. *-- Usage.......: Oct2Dect(<xOct>)
  421. *-- Example.....: ? Oct2Dec( 166 )
  422. *-- Returns.....: Numeric = decimal equivalent ( 118 in example )
  423. *-- Parameters..: xOct = octal character string or number to convert
  424. *-----------------------------------------------------------------------
  425.    
  426.    parameters xOct
  427.    private nD, cO, cVal
  428.  
  429.    if type( "xOct" ) $ "NF"
  430.       m->cO = str( m->xOct )
  431.    else
  432.       m->cO = m->xOct
  433.    endif
  434.    m->cO = upper( trim( ltrim( m->cO ) ) ) + "!"
  435.    m->nD = 0
  436.    do while len( m->cO ) > 1
  437.       m->cVal = left( m->cO, 1 )
  438.       if m->cVal # " "
  439.           m->nD = m->nD * 8 + at( m->cVal, "1234567" )
  440.       endif
  441.       m->cO = substr( m->cO, 2 )
  442.    enddo
  443.    
  444. RETURN m->nD
  445. *-- Eof: Oct2Dec()
  446.  
  447. FUNCTION Cash2Check
  448. *-----------------------------------------------------------------------
  449. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  450. *-- Date........: 03/01/1992
  451. *-- Notes.......: Converts a number of dollars and cents to a string of 
  452. *--               words appropriate for writing checks.
  453. *--               To correctly evaluate values over 16 decimal places,
  454. *--               SET PRECISION TO a value larger than the default of 16
  455. *--               before calling this function.
  456. *-- Written for.: dBASE IV, 1.1
  457. *-- Rev. History: 03/01/1992 -- Original Release
  458. *-- Calls.......: NUM2WORDS()          Function in CONVERT.PRG
  459. *--               THOU2WORDS()         Function in CONVERT.PRG
  460. *-- Called by...: Any
  461. *-- Usage.......: Cash2Check(<nCash>)
  462. *-- Example.....: ? Cash2Check( 348.27 )
  463. *-- Returns.....: Character string equivalent
  464. *-- Parameters..: nCash = money value to convert
  465. *-----------------------------------------------------------------------
  466.  
  467.    parameters nCash
  468.    private nDollars, nCents, cResult
  469.  
  470.    m->nDollars = int( m->nCash )
  471.    m->nCents = 100 * round( m->nCash - m->nDollars, 2 )
  472.    m->nResult = trim( Num2Words( m->nDollars ) )
  473.    if left( m->nResult, 1 ) = "C"          && deals with oversize number
  474.      RETURN m->nResult
  475.    endif
  476.    m->nResult = m->nResult + " dollar" + ;
  477.                             iif( m->nDollars # 1, "s", "" ) + " and "
  478.    if m->nCents # 0
  479.      RETURN m->nResult + Thou2Words( m->nCents )  + " cent" + ;
  480.                                        iif( m->nCents # 1, "s", "" )
  481.    else
  482.      RETURN m->nResult + "no cents"
  483.    endif
  484.    
  485. *-- Eof: Cash2Check()
  486.  
  487. FUNCTION Num2Words
  488. *-----------------------------------------------------------------------
  489. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  490. *-- Date........: 03/01/1992
  491. *-- Notes.......: Converts an integer to a string of words.  Limited, 
  492. *--               due to 254-character limit of dBASE strings, to 
  493. *--               numbers less than 10 ^ 15
  494. *-- Written for.: dBASE IV, 1.1
  495. *-- Rev. History: 03/01/1992 -- Original Release
  496. *-- Calls.......: THOU2WORDS()         Function in CONVERT.PRG
  497. *-- Called by...: Any
  498. *-- Usage.......: Num2Words(<nNum>)
  499. *-- Example.....: ? Num2Words( 4321568357 )
  500. *-- Returns.....: Character string equivalent
  501. *-- Parameters..: nNum = numeric integer to convert
  502. *-----------------------------------------------------------------------
  503.    
  504.    parameters nNum
  505.    private nNumleft, nScale, nGroup, cResult
  506.  
  507.    m->nNumLeft = int( m->nNum )
  508.    do case
  509.      case abs( m->nNumLeft ) >= 10 ^ 15
  510.        RETURN "Cannot convert a number in or above the quadrillions." 
  511.      case m->nNumLeft = 0
  512.        RETURN "zero"
  513.      case m->nNumLeft < 0
  514.        m->nResult = "minus "
  515.        m->nNumLeft = -m->nNumLeft
  516.      otherwise 
  517.        m->nResult = ""
  518.    endcase
  519.    do while m->nNumLeft > 0
  520.      m->nScale = int( log10( m->nNumLeft ) / 3 )
  521.      m->nGroup = int( m->nNumLeft / 10 ^ ( 3 * m->nScale ) )
  522.      m->nNumLeft = mod( m->nNumLeft, 10 ^ ( 3 * m->nScale ) )
  523.      m->nResult = m->nResult + Thou2Words( m->nGroup )
  524.      if m->nScale > 0
  525.         m->nResult = m->nResult + " " ;
  526.           + trim( substr( "thousandmillion billion trillion",;
  527.             m->nScale * 8 - 7, 8 ) )
  528.         if m->nNumLeft > 0
  529.            m->nResult = m->nResult + ", "
  530.         endif
  531.      endif
  532.    enddo           
  533.    
  534. RETURN m->nResult
  535. *-- Eof: Num2Words()
  536.  
  537. FUNCTION Thou2Words
  538. *-----------------------------------------------------------------------
  539. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  540. *-- Date........: 03/01/1992
  541. *-- Notes.......: Converts a positive integer less than 1000 to a string
  542. *--               of characters.
  543. *-- Written for.: dBASE IV, 1.1
  544. *-- Rev. History: 03/01/1992 -- Original Release
  545. *-- Calls.......: None
  546. *-- Called by...: Any
  547. *-- Usage.......: Thou2Words(<nNum>)
  548. *-- Example.....: ? Thou2Words( 834 )
  549. *-- Returns.....: Character string equivalent
  550. *-- Parameters..: nNum = numeric integer to convert
  551. *-----------------------------------------------------------------------
  552.    
  553.    parameters nNum
  554.    private cUnits, cTens, nN, cResult
  555.  
  556.    m->cUnits = "one      two      " ;
  557.              + "three    four     " ;
  558.              + "five     six      " ;
  559.              + "seven    eight    " ;
  560.              + "nine     ten      " ;
  561.              + "eleven   twelve   " ;
  562.              + "thirteen fourteen " ;
  563.              + "fifteen  sixteen  " ;
  564.              + "seventeeneighteen " ;
  565.              + "nineteen "
  566.    m->cTens = "twen thir for  fif  six  seveneigh nine "
  567.    m->nN = int( m->nNum )
  568.    if m->nN = 0
  569.       RETURN "zero"
  570.    endif
  571.    m->nResult = ""
  572.    if m->nNum > 99
  573.       m->nResult = trim( substr(m->cUnits, int(m->nNum / 100 ) ;
  574.                         * 9 - 8, 9 ) ) + " hundred"
  575.       m->nN = mod( m->nN, 100 )
  576.       if m->nN = 0
  577.          RETURN m->nResult
  578.       else
  579.          m->nResult = m->nResult + " "
  580.       endif
  581.    endif
  582.    if m->nN > 19
  583.       m->nResult = m->nResult + trim( substr( m->cTens, ;
  584.                    int( m->nN / 10 ) * 5 - 9, 5 ) ) + "ty"
  585.       m->nN = mod( m->nN, 10 )
  586.       if m->nN = 0
  587.          RETURN m->nResult
  588.       else
  589.          m->nResult = m->nResult + "-"
  590.       endif
  591.    endif
  592.    
  593. RETURN m->nResult + trim( substr( m->cUnits, m->nN * 9 - 8, 9 ) )
  594. *-- Eof: Thou2Words()
  595.  
  596. FUNCTION Ord
  597. *-----------------------------------------------------------------------
  598. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  599. *-- Date........: 03/01/1992
  600. *-- Notes.......: Converts an integer to ordinal representation by 
  601. *--               adding "st", "nd", "rd" or "th" after its digit(s)
  602. *-- Written for.: dBASE IV, 1.1
  603. *-- Rev. History: 03/01/1992 -- Original Release
  604. *-- Calls.......: None
  605. *-- Called by...: Any
  606. *-- Usage.......: Ord(<nNum>)
  607. *-- Example.....: ? Ord( 11 )
  608. *-- Returns.....: Character ordinal string equivalent ( "11th" in 
  609. *--               example )
  610. *-- Parameters..: nNum = numeric integer to convert
  611. *-----------------------------------------------------------------------
  612.    
  613.    parameters nNum
  614.    private nD
  615.  
  616.    m->nD = mod( m->nNum, 100 ) - 1
  617.                      && the -1 just happens to simplify what follows
  618.    
  619. RETURN str( m->nNum ) + iif( mod( m->nD, 10 ) > 2 .or. ;
  620.        abs( m->nD - 11 ) < 2, "th", substr( "stndrd", mod( m->nD, 10 );
  621.        * 2 + 1, 2 ) )
  622. *-- Eof: Ord()
  623.  
  624. FUNCTION Dec2Bin
  625. *-----------------------------------------------------------------------
  626. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  627. *-- Date........: 03/01/1992
  628. *-- Notes.......: Converts an unsigned number to a character
  629. *--               string giving its ASCII binary representation.
  630. *-- Written for.: dBASE IV, 1.1
  631. *-- Rev. History: 03/01/1992 -- Original Release
  632. *-- Calls.......: None
  633. *-- Called by...: Any
  634. *-- Usage.......: Dec2Bin(<nNum>,<nPlaces>)
  635. *-- Example.....: ? Dec2Bin( 35, 8 )
  636. *-- Returns.....: Character binary equivalent ( "0010 0011", in example)
  637. *-- Parameters..: nNum = number to convert
  638. *--               nPlaces = number of binary places number is to occupy
  639. *-----------------------------------------------------------------------
  640.    
  641.    parameters nNum, nPlaces
  642.    private cBits, nN
  643.  
  644.    m->cBits= ""
  645.    m->nN = m->nNum
  646.    do while len( m->cBits) < m->nPlaces
  647.       if m->nN > 0
  648.          m->cBits = str( mod( m->nN, 2 ), 1 ) +  m->cBits
  649.          m->nN = int( m->nN / 2 )
  650.       else
  651.          m->cBits = "0" + m->cBits
  652.       endif
  653.    enddo
  654.    
  655. RETURN  m->cBits
  656. *-- Eof: Dec2Bin()
  657.  
  658. FUNCTION Frac2Bin
  659. *-----------------------------------------------------------------------
  660. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  661. *-- Date........: 03/01/1992
  662. *-- Notes.......: Converts the fractional part of an unsigned number
  663. *--               to a character string giving its ASCII binary 
  664. *--               representation.
  665. *-- Written for.: dBASE IV, 1.1
  666. *-- Rev. History: 03/01/1992 -- Original Release
  667. *-- Calls.......: None
  668. *-- Called by...: Any
  669. *-- Usage.......: Frac2Bin(<nNum>,<nPlaces>)
  670. *-- Example.....: ? Frac2Bin( .35, 8 )
  671. *-- Returns.....: Character binary equivalent
  672. *-- Parameters..: nNum    = number to convert
  673. *--               nPlaces = number of binary places number is to occupy
  674. *-----------------------------------------------------------------------
  675.  
  676.    parameters nNum, nPlaces
  677.    private cBits, nN
  678.  
  679.    m->cBits = ""
  680.    m->nN = m->nNum
  681.    do while len(  m->cBits ) < m->nPlaces
  682.       if m->nN > 0
  683.          m->nN = 2 * m->nN
  684.          m->cBits =  m->cBits + str( int( m->nN ), 1 )
  685.          m->nN = m->nN - int( m->nN )
  686.       else
  687.          m->cBits =  m->cBits + "0"
  688.       endif
  689.    enddo
  690.    
  691. RETURN  m->cBits
  692. *-- Eof: Frac2Bin()
  693.  
  694. FUNCTION Num2Real
  695. *-----------------------------------------------------------------------
  696. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  697. *-- Date........: 11/26/1992
  698. *-- Notes.......: Converts a number to the ASCII representation of
  699. *--               its storage in IEEE 4 or 8-byte real format, with 
  700. *--               least significant byte (lowest in memory) first.  
  701. *--               Provided for checking the values in .MEM files, or in
  702. *--               memory float-type variables if peeking.
  703. *-- Written for.: dBASE IV Version 1.5
  704. *--               ( may be adapted to earlier versions by requiring 
  705. *--               fixed number of parameters.)
  706. *-- Rev. History: 03/01/92 - original function
  707. *--               11/26/92 - revised to call Dec2Mkd(), etc., Jay 
  708. *--               Parsons. The parameters of the revised version are 
  709. *--               not the same as those of the original.
  710. *-- Calls.......: Dec2Mkd()            Function in CONVERT.PRG
  711. *--               Dec2Mks()            Function in CONVERT.PRG
  712. *--               Dec2Hex()            Function in CONVERT.PRG
  713. *-- Called by...: Any
  714. *-- Usage.......: Num2Real(<nNum> [,<nBytes>] )
  715. *-- Example.....: ? Num2Real( 10E100, 8 )
  716. *-- Returns.....: Character string equivalent ( of a blank date, in 
  717. *--               example )
  718. *-- Parameters..: nNum = number to convert
  719. *--               nBytes = number of bytes in conversion.  Optional,
  720. *--                        will be considered 8 ( long real ) unless
  721. *--                        4 is specified.
  722. *-----------------------------------------------------------------------
  723.    
  724.    parameters nNum, nBytes
  725.    private cStr, nB, nX, MK
  726.  
  727.    m->nB = iif( type( "nBytes" ) = "N" .AND. m->nBytes = 4, 4, 8 )
  728.    declare aMK[ m->nB ]
  729.    m->cStr = ""
  730.    if "" # iif( m->nB = 8, Dec2Mkd( m->nNum, "MK" ), ;
  731.                 Dec2Mks( m->nNum, "MK" ) )
  732.       m->nX = 1
  733.       do while m->nX <= m->nB
  734.          m->cNext = Dec2Hex( asc( aMK[ m->nX ] ) )
  735.          m->cStr = m->cStr + right( "0" + ;
  736.                    Dec2Hex( asc( aMK[ m->nX ] ) ), 2 ) + " "
  737.          m->nX = m->nX + 1
  738.        enddo
  739.    endif
  740.  
  741. RETURN trim( m->cStr )
  742. *-- Eof: Num2Real()
  743.  
  744. FUNCTION Bin2Dec
  745. *-----------------------------------------------------------------------
  746. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  747. *-- Date........: 11/25/1992
  748. *-- Notes.......: Converts a string containing a binary value
  749. *--               to its numeric (decimal) equivalent.  Any characters
  750. *--               in the string other than "0" or "1" are ignored.
  751. *-- Written for.: dBASE IV, 1.1
  752. *-- Rev. History: 11/25/1992 -- original function
  753. *-- Calls.......: None
  754. *-- Called by...: Any
  755. *-- Usage.......: Bin2Dec( <cStr )
  756. *-- Example.....: ? Bin2Dec( "1000 0011" )
  757. *-- Returns.....: Numeric = equivalent ( 131 in example )
  758. *-- Parameters..: cStr1 = string holding binary value to convert
  759. *-----------------------------------------------------------------------
  760.  
  761.    parameters cStr
  762.    private cLeft, cChar, nVal
  763.  
  764.    m->nVal = 0
  765.    m->cLeft = m->cStr + "!"
  766.    do while len( m->cLeft ) > 1
  767.       m->cChar = left( m->cLeft, 1 )
  768.       m->cLeft  = substr( m->cLeft, 2 )
  769.       if m->cChar $ "01"
  770.          m->nVal = 2 * m->nVal + val( m->cChar )
  771.       endif
  772.    enddo
  773.  
  774. RETURN m->nVal
  775. *-- Eof: Bin2Dec()
  776.  
  777. FUNCTION Dec2Mkd
  778. *-----------------------------------------------------------------------
  779. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  780. *-- Date........: 11/26/1992
  781. *-- Notes.......: Converts a numeric value to eight chr() values in 
  782. *--               array. See notes to Dec2Mki() (CONVERT.PRG).
  783. *--               Returns null string if array not declared or declared
  784. *--               with too few elements.
  785. *--               This is roughly equivalent to MKD$() in BASIC.
  786. *--               Concatenation of the array elements gives the value
  787. *--               in IEEE long real format ( low-order byte first.)
  788. *--               From high to low, the 64 bits are:
  789. *--                     1 bit sign, 1 = negative
  790. *--                    11 bits exponent base 2 + 1023
  791. *--                    23 bits mantissa with initial "1." omitted as
  792. *--                             understood.
  793. *--               dBASE uses this format for floats and dates internally
  794. *--               and in .MEM files; obviously, the dBASE float() 
  795. *--               function will make the same conversion more quickly, 
  796. *--               but creates difficulties in accessing the bytes as 
  797. *--               converted.
  798. *-- Written for.: dBASE IV, 1.1
  799. *-- Rev. History: 11/26/1992 -- original function
  800. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  801. *--               Dec2Bin()  - Function in Convert.prg
  802. *--               Frac2Bin() - Function in Convert.prg
  803. *-- Called by...: Any
  804. *-- Usage.......: Dec2Mkd( nVar, cName )
  805. *-- Example.....: ? Dec2Mkd( -1, "MK" )
  806. *-- Returns.....: name of array of which elements [ 1 ] - [ 8 ] contain
  807. *--               chr() values equivalent to bytes of value; or null 
  808. *--               string.
  809. *-- Parameters..: nVar  = number to convert
  810. *--               cName = name of array to use, which must be public and
  811. *--                       previously declared with enough elements
  812. *-- Side effects: Alters contents of array
  813. *-----------------------------------------------------------------------
  814.  
  815.    parameters nVar, cName
  816.    private cStr, cBin, nVal, nExp, nMant, nX
  817.  
  818.    m->cStr = ""
  819.    if type( "&cName.[ 8 ]" ) # "U"
  820.       m->cStr = m->cName
  821.       if m->nVar = 0
  822.          m->nX = 1
  823.          do while m->nX < 9
  824.             &cStr.[ m->nX ] = chr( 0 )
  825.             m->nX = m->nX + 1
  826.          enddo
  827.       else
  828.          m->cBin = iif( m->nVar < 0, "1", "0" )
  829.          m->nVal = abs( m->nVar )
  830.          m->nExp = int( log( m->nVar ) / log( 2 ) )
  831.          m->nMant = m->nVal / 2 ^ m->nExp - 1
  832.          m->cBin = m->cBin + Dec2Bin( m->nExp + 1023, 11 ) +;
  833.                    Frac2Bin( m->nMant, 52 )
  834.          m->nX = 1
  835.          do while m->nX < 9
  836.             &cStr.[ m->nX ] = chr( Bin2Dec( substr( m->cBin, ;
  837.                                 65 - m->nX * 8, 8 ) ) )
  838.             m->nX = m->nX + 1
  839.          enddo
  840.       endif
  841.    endif
  842.  
  843. RETURN m->cStr
  844. *-- EoF: Dec2Mkd()
  845.  
  846. FUNCTION Dec2Mki
  847. *-----------------------------------------------------------------------
  848. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  849. *-- Date........: 11/26/1992
  850. *-- Notes.......: Converts an integer in the range -32,768 to +32,767
  851. *--               to two chr() values equivalent to the two bytes 
  852. *--               created by the BASIC MKI$ function.
  853. *--                     Because of the impossibility of storing a null,
  854. *--               chr( 0 ), as a character in a dBASE string, the chr()
  855. *--               values are stored in the first two elements of an 
  856. *--               array, with the low-order byte as element[ 1 ].  Array
  857. *--               name must be passed as second parameter.  Array name 
  858. *--               will be returned unless the parameter is out of range 
  859. *--               or array has too few elements, in which case the null
  860. *--               string is returned.
  861. *--                     Concatenation of the array elements such as by
  862. *--                 fwrite( <nHandle>,<Arrayname>[ 1 ] )
  863. *--                 fwrite( <nHandle>,<Arrayname>[ 2 ] )
  864. *--               writes the same value as the BASIC MKI$ function.
  865. *--               The same format is used by dBASE for internal storage
  866. *--               of integers within the range, and by C as a signed int
  867. *-- Written for.: dBASE IV, 1.1
  868. *-- Rev. History: 11/26/1992 -- original function
  869. *-- Calls.......: None
  870. *-- Called by...: Any
  871. *-- Usage.......: Dec2Mki( nInt, cName )
  872. *-- Example.....: ? Dec2Mki( -1, "MK" )
  873. *-- Returns.....: name of array of which elements contain char 
  874. *--               equivalents, chr( 255) and chr( 255 ) in example; 
  875. *--               or null string.
  876. *-- Parameters..: nInt  = integer to convert
  877. *--               cName = name of array to use, which must be public and
  878. *--                       previously declared with enough elements
  879. *-- Side effects: Alters contents of array
  880. *-----------------------------------------------------------------------
  881.  
  882.    parameters nInt, cName
  883.    private nVal, cStr, nX
  884.  
  885.    m->cStr = ""
  886.    if type( "&cName.[ 2 ]" ) # "U"
  887.       m->cStr = m->cName
  888.       if m->nInt = int( m->nInt ) .and. m->nInt >= -32768;
  889.                    .and. m->nInt <= 32767
  890.          m->nVal = m->nInt + iif( m->nInt < 0, 65536, 0 )
  891.          m->nX = 1
  892.          do while m->nX < 3
  893.             &cStr.[ m->nX ] = chr( mod( m->nVal, 256 ) )
  894.             m->nVal = int( m->nVal / 256 )
  895.             m->nX = m->nX + 1
  896.          enddo
  897.       endif
  898.    endif
  899.  
  900. RETURN m->cStr
  901. *-- EoF: Dec2Mki()
  902.  
  903. FUNCTION Dec2Mkl
  904. *-----------------------------------------------------------------------
  905. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  906. *-- Date........: 11/26/1992
  907. *-- Notes.......: Converts an integer in the range -2^31 to +2^31 - 1
  908. *--               to four chr() values in array.  See notes to Dec2Mki()
  909. *--               Returns null string if parameter is out of range or
  910. *--               array not declared or declared with too few elements.
  911. *--               This is mostly equivalent to MKL$() in BASIC.
  912. *-- Written for.: dBASE IV, 1.1
  913. *-- Rev. History: 11/26/1992 -- original function
  914. *-- Calls.......: None
  915. *-- Called by...: Any
  916. *-- Usage.......: Dec2Mkl( nInt, cName )
  917. *-- Example.....: ? Dec2Mkl( -1, "MK" )
  918. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  919. *--               chr() values equivalent to bytes of value; or null 
  920. *--               string.
  921. *-- Parameters..: nInt  = integer to convert
  922. *--               cName = name of array to use, which must be public and
  923. *--                       previously declared with enough elements
  924. *-- Side effects: Alters contents of array
  925. *-----------------------------------------------------------------------
  926.  
  927.    parameters nInt, cName
  928.    private m->nVal, cStr, nX
  929.  
  930.    m->cStr = ""
  931.    if type( "&cName.[ 4 ]" ) # "U"
  932.       m->cStr = m->cName
  933.       if m->nInt = int( m->nInt ) .and. m->nInt >= -2 ^ 31 .and.;
  934.                         m->nInt < 2 ^ 31
  935.          m->nVal = m->nInt + iif( m->nInt < 0, 2 ^ 32, 0 )
  936.          m->nX = 1
  937.          do while m->nX < 5
  938.             &cStr.[ m->nX ] = chr( mod( m->nVal, 256 ) )
  939.             m->nVal = int( m->nVal / 256 )
  940.             m->nX = m->nX + 1
  941.          enddo
  942.       endif
  943.    endif
  944.  
  945. RETURN m->cStr
  946. *-- EoF: Dec2Mkl()
  947.  
  948. FUNCTION Dec2Mks
  949. *-----------------------------------------------------------------------
  950. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  951. *-- Date........: 11/26/1992
  952. *-- Notes.......: Converts a numeric value to four chr() values in array
  953. *--               See notes to Dec2Mki().
  954. *--               Returns null string if array not declared or declared
  955. *--               with too few elements.
  956. *--               This is mostly equivalent to MKS$() in BASIC.
  957. *--               Concatenation of the array elements gives the value
  958. *--               in IEEE short real format ( low-order byte first.)
  959. *--               From high to low, the 32 bits are:
  960. *--                     1 bit sign, 1 = negative
  961. *--                     8 bits exponent base 2 + 127
  962. *--                    23 bits mantissa with initial "1." omitted as
  963. *--                             understood.
  964. *-- Written for.: dBASE IV, 1.1
  965. *-- Rev. History: 11/26/1992 -- original function
  966. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  967. *--               Dec2Bin()  - Function in Convert.prg
  968. *--               Frac2Bin() - Function in Convert.prg
  969. *-- Called by...: Any
  970. *-- Usage.......: Dec2Mks( nVar, cName )
  971. *-- Example.....: ? Dec2Mks( -1, "MK" )
  972. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  973. *--               chr() values equivalent to bytes of value; or null 
  974. *--               string.
  975. *-- Parameters..: nVar  = number to convert
  976. *--               cName = name of array to use, which must be public and
  977. *--                       previously declared with enough elements
  978. *-- Side effects: Alters contents of array
  979. *-----------------------------------------------------------------------
  980.  
  981.    parameters nVar, cName
  982.    private cStr, cBin, nVal, nExp, nMant, nX
  983.  
  984.    m->cStr = ""
  985.    if type( "&cName.[ 4 ]" ) # "U"
  986.       m->cStr = m->cName
  987.       if m->nVar = 0
  988.          m->nX = 1
  989.          do while m->nX < 5
  990.             &cStr.[ m->nX ] = chr( 0 )
  991.             m->nX = m->nX + 1
  992.          enddo
  993.       else
  994.          m->cBin = iif( m->nVar < 0, "1", "0" )
  995.          m->nVal = abs( m->nVar )
  996.          m->nExp = int( log( m->nVar ) / log( 2 ) )
  997.          m->nMant = m->nVal / 2 ^ m->nExp - 1
  998.          m->cBin = m->cBin + Dec2Bin( m->nExp + 127, 8 ) + ;
  999.                    Frac2Bin( m->nMant, 23 )
  1000.          m->nX = 1
  1001.          do while m->nX < 5
  1002.             &cStr.[ m->nX ] = chr( Bin2Dec( substr( m->cBin, ;
  1003.                               33 - m->nX * 8, 8 ) ) )
  1004.             m->nX = m->nX + 1
  1005.          enddo
  1006.       endif
  1007.    endif
  1008.  
  1009. RETURN m->cStr
  1010. *-- EoF: Dec2Mks()
  1011.  
  1012. FUNCTION Dec2MSks
  1013. *-----------------------------------------------------------------------
  1014. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  1015. *-- Date........: 12/01/1992
  1016. *-- Notes.......: Converts a numeric value to four chr() values in 
  1017. *--               array. See notes to Dec2Mki().  USES OBSOLETE 
  1018. *--               MICROSOFT FORMAT. Returns null string if array not 
  1019. *--               declared or declared with too few elements.
  1020. *--               This is mostly equivalent to MKS$() in old Microsoft
  1021. *--               BASIC. Concatenation of the array elements gives the 
  1022. *--               value as stored in old MicroSoft four-byte real 
  1023. *--               format. From high to low, the 32 bits are:
  1024. *--                     8 bits exponent base 2 + 128
  1025. *--                     1 bit sign, 1 = negative
  1026. *--                    23 bits mantissa with initial ".1" omitted as
  1027. *--                             understood.
  1028. *-- Written for.: dBASE IV, 1.1
  1029. *-- Rev. History: 12/01/1992 -- original function
  1030. *-- Calls.......: Bin2Dec()  - Function in Convert.prg
  1031. *--               Dec2Bin()  - Function in Convert.prg
  1032. *--               Frac2Bin() - Function in Convert.prg
  1033. *-- Called by...: Any
  1034. *-- Usage.......: Dec2MSks( nVar, cName )
  1035. *-- Example.....: ? Dec2MSks( -1, "MK" )
  1036. *-- Returns.....: name of array of which elements [ 1 ] - [ 4 ] contain
  1037. *--               chr() values equivalent to bytes of value; or null 
  1038. *--               string.
  1039. *-- Parameters..: nVar  = number to convert
  1040. *--               cName = name of array to use, which must be public and
  1041. *--                       previously declared with enough elements
  1042. *-- Side effects: Alters contents of array
  1043. *-----------------------------------------------------------------------
  1044.  
  1045.    parameters nVar, cName
  1046.    private cStr, cBin, nVal, nExp, nMant, nX
  1047.  
  1048.    m->cStr = ""
  1049.    if type( "&cName.[ 4 ]" ) # "U"
  1050.       m->cStr = m->cName
  1051.       if m->nVar = 0
  1052.          m->nX = 1
  1053.          do while m->nX < 5
  1054.             &cStr.[ m->nX ] = chr( 0 )
  1055.             m->nX = m->nX + 1
  1056.          enddo
  1057.       else
  1058.          m->cBin = iif( m->nVar < 0, "1", "0" )
  1059.          m->nVal = abs( m->nVar )
  1060.          m->nExp = int( log( m->nVar ) / log( 2 ) )
  1061.          m->nMant = m->nVal / 2 ^ m->nExp - 1
  1062.          m->cBin = Dec2Bin( m->nExp + 129, 8 ) + m->cBin + ;
  1063.                     Frac2Bin( m->nMant, 23 )
  1064.          m->nX = 1
  1065.          do while m->nX < 5
  1066.             &cStr.[ m->nX ] = chr( Bin2Dec( substr( m->cBin,;
  1067.                               33 - m->nX * 8, 8 ) ) )
  1068.             m->nX = m->nX + 1
  1069.          enddo
  1070.       endif
  1071.    endif
  1072.  
  1073. RETURN m->cStr
  1074. *-- EoF: Dec2MSks()
  1075.  
  1076. FUNCTION Mki2Dec
  1077. *-----------------------------------------------------------------------
  1078. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  1079. *-- Date........: 11/25/1992
  1080. *-- Notes.......: Converts two bytes storing a signed short integer
  1081. *--               ( as saved by the BASIC MKI$ function, e. g. )
  1082. *--               to its numeric (decimal) equivalent.  The format
  1083. *--               accommodates values from 8000 ( -32,768 ) to
  1084. *--               7FFF ( +32,767 ); the low-order byte is stored first
  1085. *--               and is expected as the first parameter.
  1086. *--                     This is the equivalent of CVI() in BASIC.
  1087. *--                     While this could easily be modified to accept
  1088. *--               a two-character string as the parameter, dBASE and
  1089. *--               particularly fread() will have trouble with such a
  1090. *--               string that contains a null ( chr( 0 ) ).
  1091. *-- Written for.: dBASE IV, 1.1
  1092. *-- Rev. History: 11/25/1992 -- original function
  1093. *-- Calls.......: None
  1094. *-- Called by...: Any
  1095. *-- Usage.......: Mki2Dec( <c1>, <c2> )
  1096. *-- Example.....: ? Mki2Dec( chr( 255 ), chr( 255 ) )
  1097. *-- Returns.....: Numeric = equivalent ( -1 in example )
  1098. *-- Parameters..: c1, c2 = chars holding value to convert
  1099. *-----------------------------------------------------------------------
  1100.  
  1101.    parameters c1, c2
  1102.    private nVal
  1103.  
  1104.    m->nVal = asc( m->c1 ) + 256 * asc( m->c2 )
  1105.    if m->nVal > 32767
  1106.       m->nVal = m->nVal - 65536
  1107.    endif
  1108.  
  1109. RETURN m->nVal
  1110. *-- EoF: Mki2Dec()
  1111.  
  1112. FUNCTION Mkl2Dec
  1113. *-----------------------------------------------------------------------
  1114. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  1115. *-- Date........: 11/26/1992
  1116. *-- Notes.......: Converts four bytes storing a signed long integer
  1117. *--               ( as saved by the BASIC MKL$ function, e. g. )
  1118. *--               to its numeric (decimal) equivalent.  The low-order
  1119. *--               byte is stored first and is expected as the first
  1120. *--               parameter.
  1121. *--                     This is the equivalent of CVL() in BASIC.
  1122. *--                     While this could easily be modified to accept
  1123. *--               a four-character string as the parameter, dBASE and
  1124. *--               particularly fread() will have trouble with such a
  1125. *--               string that contains a null ( chr( 0 ) ).
  1126. *-- Written for.: dBASE IV, 1.1
  1127. *-- Rev. History: 11/26/1992 -- original function
  1128. *-- Calls.......: None
  1129. *-- Called by...: Any
  1130. *-- Usage.......: Mkl2Dec( <c1>, <c2>, <c3>, <c4> )
  1131. *-- Example.....: ? Mkl2Dec( chr( 255 ), chr( 255 ), chr(255 ), ;
  1132. *--                          chr( 255) )
  1133. *-- Returns.....: Numeric = equivalent ( -1 in example )
  1134. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1135. *-----------------------------------------------------------------------
  1136.  
  1137.    parameters c1, c2, c3, c4
  1138.    private nVal, nX, cVar
  1139.  
  1140.    m->nVal = 0
  1141.    m->nX = 4
  1142.    do while m->nX > 0
  1143.       m->cVar = "c" + str( m->nX, 1 )
  1144.       m->nVal = 256 * m->nVal + asc( &cVar. )
  1145.       m->nX = m->nX - 1
  1146.    enddo
  1147.    if m->nVal >= 2 ^ 31
  1148.       m->nVal = m->nVal - 2 ^ 32
  1149.    endif
  1150.  
  1151. RETURN m->nVal
  1152. *-- EoF: Mkl2Dec()
  1153.  
  1154. FUNCTION Num2Str
  1155. *-----------------------------------------------------------------------
  1156. *-- Programmer..: Angus Scott-Fleming (CIS: 75500,3223)
  1157. *-- Date........: 06/09/1992
  1158. *-- Notes.......: Converts a number to a string like str(), storing all
  1159. *--               decimal places. Does not require knowing the number of
  1160. *--               decimal places first.
  1161. *-- Written for.: dBASE IV, 1.1
  1162. *-- Rev. History: 06/09/1992 -- Angus took Jay's routine and overhauled 
  1163. *--                             it.
  1164. *-- Calls.......: None
  1165. *-- Called by...: Any
  1166. *-- Usage.......: Num2Str(<nNumber>)
  1167. *-- Example.....: ? Num2Str( 415.25000000000001 )
  1168. *-- Returns.....: Character = representation of number 
  1169. *--                           ( "415.2500000000001" in example )
  1170. *-- Parameters..: nNumber = number to represent
  1171. *-----------------------------------------------------------------------
  1172.  
  1173.    parameters nNumber
  1174.    private nInteger, nFraction, cFracstr, nDec
  1175.  
  1176.    m->nInteger = int( m->nNumber )
  1177.    m->nFraction = abs( m->nNumber - m->nInteger )
  1178.    if m->nFraction = 0
  1179.       m->nFracStr = ""
  1180.    else
  1181.       *-- note that the maximum # of decimals is 18
  1182.       m->nFracStr = ltrim(str(m->nFraction,19,18))
  1183.       do while right(m->nFracStr,1) = "0"
  1184.          m->nFracStr = left(m->nFracStr,len(m->nFracStr)-1)
  1185.       enddo
  1186.    endif
  1187.    
  1188. RETURN ltrim( str( m->nInteger ) ) + m->nFracStr
  1189. *-- Eof: Num2Str()
  1190.  
  1191. FUNCTION Mkd2Dec
  1192. *-----------------------------------------------------------------------
  1193. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  1194. *-- Date........: 04/12/1993
  1195. *-- Notes.......: Converts eight bytes storing an IEEE long real value
  1196. *--               ( as saved by the BASIC MKD$ function, e. g. )
  1197. *--               to its numeric (decimal) equivalent.  As usual, the
  1198. *--               eight bytes of the value are stored low-order to high-
  1199. *--               order, and are expected as parameters in that order.
  1200. *--               From high to low, the 64 bits are:
  1201. *--                     1 bit sign, 1 = negative
  1202. *--                    11 bits exponent base 2 + 1023
  1203. *--                    52 bits mantissa with initial "1." omitted as
  1204. *--                             understood.
  1205. *--                    The function is written to require eight separate
  1206. *--               parameters rather than an eight-character string 
  1207. *--               because fread() will choke on reading the value as a 
  1208. *--               single string if it contains nulls ( chr( 0 ) ).
  1209. *--               This is the equivalent of CVD() in BASIC.
  1210. *-- Written for.: dBASE IV, 1.1
  1211. *-- Rev. History: 11/26/1992 -- original function
  1212. *--               04/12/1993 -- changed to work around dBASE IV 
  1213. *--                             2.0 mod() bug, Jay Parsons
  1214. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1215. *-- Called by...: Any
  1216. *-- Usage.......: Mkd2Dec( <c1>, . . . <c8> )
  1217. *-- Example.....: ? Mkd2Dec( chr( 0 ), chr( 0 ), chr( 0 ), chr( 0 ), ;
  1218. *--                     chr( 0 ), chr( 0 ), chr( 248 ), chr( 3 )
  1219. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1220. *-- Parameters..: c1 . . . c8 = chars holding value to convert
  1221. *-----------------------------------------------------------------------
  1222.  
  1223.    parameters c1, c2, c3, c4, c5, c6, c7, c8
  1224.    private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal, nZ
  1225.  
  1226.    m->nX = 8
  1227.    m->nZ = 0
  1228.    m->cBin = ""
  1229.    do while m->nX > 0
  1230.       m->cVar = "c" + str( m->nX, 1 )
  1231.       m->nVal = asc( &cVar. )
  1232.       m->nZ = m->nZ + m->nVal
  1233.       m->nY = 7
  1234.       do while m->nY >=0
  1235.          m->cBin = m->cBin + iif( m->nVal >= 2 ^ m->nY, "1", "0" )
  1236.          m->nVal = iif( m->nVal = 0, 0, mod( m->nVal, 2 ^ m->nY ) )
  1237.          m->nY = m->nY - 1
  1238.       enddo
  1239.       m->nX = m->nX - 1
  1240.    enddo
  1241.    if m->nZ = 0
  1242.       m->nVal = 0
  1243.    else
  1244.       m->nSign = iif( left( m->cBin, 1 ) = "1", -1, 1 )
  1245.       m->nExp = Bin2Dec( substr( m->cBin, 2, 11) ) - 1023
  1246.       m->cMant = "1" + right( m->cBin, 52 )
  1247.       m->nVal = Bin2Dec( m->cMant ) * 2 ^ ( m->nExp - 52 ) * m->nSign
  1248.    endif
  1249.  
  1250. RETURN m->nVal
  1251. *-- EoF: Mkd2Dec()
  1252.  
  1253. FUNCTION Mks2Dec
  1254. *-----------------------------------------------------------------------
  1255. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  1256. *-- Date........: 04/12/1993
  1257. *-- Notes.......: Converts four bytes storing an IEEE short real value
  1258. *--               ( as saved by the BASIC MKS$ function, e. g. )
  1259. *--               to its numeric (decimal) equivalent.  As usual, the
  1260. *--               four bytes of the value are stored low-order to high-
  1261. *--               order, and are expected as parameters in that order.
  1262. *--               From high to low, the 32 bits are:
  1263. *--                     1 bit sign, 1 = negative
  1264. *--                     8 bits exponent base 2 + 127
  1265. *--                    23 bits mantissa with initial "1." omitted as
  1266. *--                             understood.
  1267. *--                    The function is written to require four separate
  1268. *--               parameters rather than a four-character string because
  1269. *--               fread() will choke on reading the value as a single
  1270. *--               string if it contains nulls ( chr( 0 ) ).
  1271. *--               This is the equivalent of CVS() in BASIC.
  1272. *-- Written for.: dBASE IV, 1.1
  1273. *-- Rev. History: 11/25/1992 -- original function
  1274. *--               04/12/1993 -- changed to work around dBASE 
  1275. *--                             IV 2.0 mod() bug, Jay Parsons
  1276. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1277. *-- Called by...: Any
  1278. *-- Usage.......: Mks2Dec( <c1>, <c2>, <c3>, <c4> )
  1279. *-- Example.....: ? Mks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ) )
  1280. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1281. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1282. *-----------------------------------------------------------------------
  1283.  
  1284.    parameters c1, c2, c3, c4
  1285.    private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal
  1286.  
  1287.    if asc( m->c1 ) + asc( m->c2 ) + asc( m->c3 ) + asc( m->c4 ) = 0
  1288.       m->nVal = 0
  1289.    else
  1290.       m->nX = 4
  1291.       m->cBin = ""
  1292.       do while m->nX > 0
  1293.          m->cVar = "c" + str( m->nX, 1 )
  1294.          m->nVal = asc( &cVar. )
  1295.          m->nY = 7
  1296.          do while m->nY >=0
  1297.             m->cBin = m->cBin + iif( m->nVal >= 2 ^ m->nY, "1", "0" )
  1298.             m->nVal = iif( m->nVal = 0, 0, mod( m->nVal, 2 ^ m->nY ) )
  1299.             m->nY = m->nY - 1
  1300.          enddo
  1301.          m->nX = m->nX - 1
  1302.       enddo
  1303.       m->nSign = iif( left( m->cBin, 1 ) = "1", -1, 1 )
  1304.       m->nExp = Bin2Dec( substr( m->cBin, 2, 8 ) ) - 127
  1305.       m->cMant = "1" + right( m->cBin, 23 )
  1306.       m->nVal = Bin2Dec( m->cMant ) * 2 ^ ( m->nExp - 23 ) * m->nSign
  1307.    endif
  1308.  
  1309. RETURN m->nVal
  1310. *-- EoF: Mks2Dec()
  1311.  
  1312. FUNCTION MSks2Dec
  1313. *-----------------------------------------------------------------------
  1314. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  1315. *-- Date........: 04/12/1993
  1316. *-- Notes.......: Converts four bytes storing an old-style Microsoft
  1317. *--               short real value ( as saved by the BASIC MKS$ 
  1318. *--               function, e. g. ) to its numeric (decimal) equivalent.
  1319. *--               As usual, the four bytes of the value are stored low-
  1320. *--               order to high-order, and are expected as parameters 
  1321. *--               in that order. From high to low, the 32 bits are:
  1322. *--                     8 bits exponent base 2 + 128
  1323. *--                     1 bit sign, 1 = negative
  1324. *--                    23 bits mantissa with initial ".1" omitted as
  1325. *--                             understood.
  1326. *--                    The function is written to require four separate
  1327. *--               parameters rather than a four-character string because
  1328. *--               fread() will choke on reading the value as a single
  1329. *--               string if it contains nulls ( chr( 0 ) ).
  1330. *--               This is the equivalent of CVS() in old Microsoft BASIC
  1331. *-- Written for.: dBASE IV, 1.1
  1332. *-- Rev. History: 11/28/1992 -- original function
  1333. *--               04/12/1993 -- changed to work around dBASE IV 
  1334. *--                             2.0 mod() bug, Jay Parsons
  1335. *-- Calls.......: Bin2Dec() - Function in Convert.prg
  1336. *-- Called by...: Any
  1337. *-- Usage.......: MSks2Dec( <c1>, <c2>, <c3>, <c4> )
  1338. *-- Example.....: ? MSks2Dec( chr( 0 ), chr( 0 ), chr( 128 ), chr( 63 ))
  1339. *-- Returns.....: Numeric = equivalent ( 1 in example )
  1340. *-- Parameters..: c1, c2, c3, c4 = chars holding value to convert
  1341. *-----------------------------------------------------------------------
  1342.  
  1343.    parameters c1, c2, c3, c4
  1344.    private nX, nY, cVar, cBin, nSign, nExp, cMant, nVal
  1345.  
  1346.    if asc( m->c1 ) + asc( m->c2 ) + asc( m->c3 ) + asc( m->c4 ) = 0
  1347.       m->nVal = 0
  1348.    else
  1349.       m->nX = 4
  1350.       m->cBin = ""
  1351.       do while m->nX > 0
  1352.          m->cVar = "c" + str( m->nX, 1 )
  1353.          m->nVal = asc( &cVar. )
  1354.          m->nY = 7
  1355.          do while m->nY >=0
  1356.             m->cBin = m->cBin + iif( m->nVal >= 2 ^ m->nY, "1", "0" )
  1357.             m->nVal = iif( m->nVal = 0, 0, mod( m->nVal, 2 ^ m->nY ) )
  1358.             m->nY = m->nY - 1
  1359.          enddo
  1360.          m->nX = m->nX - 1
  1361.       enddo
  1362.       m->nSign = iif( substr( m->cBin, 9, 1 ) = "1", -1, 1 )
  1363.       m->nExp = Bin2Dec( left( m->cBin, 8 ) ) - 128
  1364.       m->cMant = "1" + right( m->cBin, 23 )
  1365.       m->nVal = Bin2Dec( m->cMant ) * 2 ^ ( m->nExp - 24 ) * m->nSign
  1366.    endif
  1367.  
  1368. RETURN m->nVal
  1369. *-- EoF: MSks2Dec()
  1370.  
  1371. FUNCTION Ordinal
  1372. *-----------------------------------------------------------------------
  1373. *-- Programmer..: Jay Parsons (CIS: 72662,1302)
  1374. *-- Date........: 12/03/1992
  1375. *-- Notes.......: Returns ordinal string for a positive integer < 100.
  1376. *--               For higher numbers, use Num2Words on int( n/100 ), 
  1377. *--               then use this on mod( n, 100 ) or if mod( n, 100 ) = 
  1378. *--               0, add "th" ).
  1379. *-- Written for.: dBASE IV, 1.1
  1380. *-- Rev. History: 11/19/1992 - original function
  1381. *--               12/03/1992 - Jay Parsons - changed notes and variable 
  1382. *--                            names, replaced five lines with an "iif" 
  1383. *--                            line
  1384. *-- Calls.......: None
  1385. *-- Called by...: Any
  1386. *-- Usage.......: Ordinal( <nNum> )
  1387. *-- Example.....: ? Ordinal( 31 )          && returns "thirty-first"
  1388. *-- Returns.....: String giving ordinal value ( position ) of number, 
  1389. *--               or null
  1390. *-- Parameters..: nNum = integer > 0 and < 100
  1391. *-----------------------------------------------------------------------
  1392.  
  1393.    parameters nNum
  1394.    private cUnits, cTeens, cDecades, nRest, cOrd
  1395.  
  1396.    *-- 6        123456123456123456123456123456123456123456123456123456
  1397.    m->cUnits = "     four  fif   six   seven eigh  nin   ten   "+;
  1398.                "eleventwelf "
  1399.    *-- 5          1234512345123451234512345123451234512345
  1400.    m->cTeens =   "    thir four fif  six  seveneigh nine  "
  1401.    m->cDecades = "    twen thir for  fif  six  seveneigh nine"
  1402.  
  1403.    m->nRest = m->nNum
  1404.    m->cOrd = ""
  1405.    if m->nRest # int( nRet ) .OR. m->nRest < 1 .OR. m->nRest > 99
  1406.       m->nRest = 0
  1407.    endif
  1408.  
  1409.    if m->nRest > 19
  1410.       m->cOrd = trim( substr( m->cDecades, 5 * ;
  1411.                 ( int( m->nRest / 10 ) - 1 ), 5 ) ) + "t"
  1412.       m->nRest = mod( m->nRest, 10 )
  1413.       m->cOrd = m->cOrd + iif( m->nRest = 0, "ieth", "y-" )
  1414.    endif
  1415.  
  1416.    do case
  1417.       case m->nRest > 12
  1418.          m->cOrd = m->cOrd + trim( substr( m->cTeens, 5 * ;
  1419.                     ( m->nRest - 12 ), 5 ) ) + "teenth"
  1420.       case m->nRest > 3
  1421.          m->cOrd = m->cOrd + trim( substr( m->cUnits, ;
  1422.                      6 * ( m->nRest - 3 ), 6 ) ) + "th"
  1423.       case m->nRest > 0
  1424.          m->cOrd = m->cOrd + trim( substr( "     first secondthird ", ;
  1425.                                    6 * m->nRest, 6 ) )
  1426.    endcase
  1427.  
  1428. RETURN m->cOrd
  1429. *-- EoF() Ordinal
  1430.  
  1431. *-----------------------------------------------------------------------
  1432. *-- EoP: CONVERT.PRG
  1433. *-----------------------------------------------------------------------
  1434.